home *** CD-ROM | disk | FTP | other *** search
/ Acorn RISC PD-CD 1 / Acorn RISC PD-CD 1.iso / languages / _tile / test / bubblesort < prev    next >
Encoding:
Text File  |  1991-08-10  |  1.2 KB  |  64 lines
  1. .( Loading Bubble Sort benchmark...) cr
  2.  
  3. \ A classical benchmark of an O(n**2) algorithm; Bubble sort
  4. \
  5. \ Part of the programs gathered by John Hennessy for the MIPS
  6. \ RISC project at Stanford. Translated to forth by Marty Fraeman
  7. \ Johns Hopkins University/Applied Physics Laboratory.
  8.  
  9. variable seed ( -- addr)
  10.  
  11. : initiate-seed ( -- )  74755 seed ! ;
  12. : random  ( -- n )  seed @ 1309 * 13849 + 65535 and dup seed ! ;
  13.  
  14. 500 constant elements ( -- int)
  15.  
  16. align create list elements cells allot
  17.  
  18. : initiate-list ( -- )
  19.   list elements cells + list do random i ! cell +loop
  20. ;
  21.  
  22. : dump-list ( -- )
  23.   list elements cells + list do i @ . cell +loop cr
  24. ;
  25.  
  26. : verify-list ( -- )
  27.   list elements 1- cells bounds do
  28.     i 2@ > abort" bubble-sort: not sorted"
  29.   cell +loop
  30. ;
  31.  
  32. : bubble ( -- )
  33.   1 elements 1 do
  34.     list elements i - cells bounds do
  35.       i 2@ > if i 2@ swap i 2! then
  36.     cell +loop 
  37.   loop
  38. ;
  39.  
  40. : bubble-sort ( -- )
  41.   initiate-seed
  42.   initiate-list
  43.   bubble
  44.   verify-list
  45. ;
  46.  
  47. : bubble-with-flag ( -- )
  48.   1 elements 1 do
  49.     true list elements i - cells bounds do
  50.       i 2@ > if i 2@ swap i 2! drop false then
  51.     cell +loop 
  52.     if leave then
  53.   loop
  54. ;
  55.   
  56. : bubble-sort-with-flag ( -- )
  57.   initiate-seed
  58.   initiate-list
  59.   bubble-with-flag
  60.   verify-list
  61. ;
  62.  
  63. forth only
  64.